home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / BCUCOF.DEM < prev    next >
Text File  |  1991-05-01  |  998b  |  40 lines
  1. PROGRAM d3r10(input,output);
  2. (* driver for routine BCUCOF *)
  3. TYPE
  4.    gl4array = ARRAY [1..4] OF real;
  5.    gl4by4  = ARRAY [1..4,1..4] OF real;
  6. VAR
  7.    d1,d2,ee,x1x2 : real;
  8.    i,j : integer;
  9.    y,y1,y2,y12,x1,x2 : gl4array;
  10.    c : gl4by4;
  11.    wt : ARRAY [1..16,1..16] OF real;
  12.    glflag : boolean;
  13.  
  14. (*$I MODFILE.PAS *)
  15. (*$I BCUCOF.PAS *)
  16.  
  17. BEGIN
  18.    glflag := true;
  19.    x1[1] := 0.0; x1[2] := 2.0; x1[3] := 2.0; x1[4] := 0.0;
  20.    x2[1] := 0.0; x2[2] := 0.0; x2[3] := 2.0; x2[4] := 2.0;
  21.    d1 := x1[2]-x1[1];
  22.    d2 := x2[4]-x2[1];
  23.    FOR i := 1 to 4 DO BEGIN
  24.       x1x2 := x1[i]*x2[i];
  25.       ee := exp(-x1x2);
  26.       y[i] := x1x2*ee;
  27.       y1[i] := x2[i]*(1.0-x1x2)*ee;
  28.       y2[i] := x1[i]*(1.0-x1x2)*ee;
  29.       y12[i] := (1.0-3.0*x1x2+sqr(x1x2))*ee
  30.    END;
  31.    bcucof(y,y1,y2,y12,d1,d2,c);
  32.    writeln;
  33.    writeln('Coefficients for bicubic interpolation:');
  34.    writeln;
  35.    FOR i := 1 to 4 DO BEGIN
  36.       FOR j := 1 to 4 DO write(c[i,j]:12:6);
  37.       writeln
  38.    END
  39. END.
  40.